home *** CD-ROM | disk | FTP | other *** search
/ Video Toaster 4.0 / Video Toaster v4.0.iso / arexx / modeler / text.lwm < prev    next >
Text File  |  1993-12-13  |  6KB  |  276 lines
  1. /* CMD: Text
  2.  * By Arnie Cachelin © 1993 NewTek Inc. */
  3. /* Tue Sep 14 20:03:06 1993 */
  4.  
  5. libadd = addlib("LWModelerARexx.port",0)
  6. signal on error
  7. signal on syntax
  8.  
  9. call addlib "rexxsupport.library", 0, -30, 0
  10. MATHLIB="rexxmathlib.library"
  11. IF POS(MATHLIB , SHOW('L')) = 0 THEN
  12.   IF ~ADDLIB(MATHLIB , 0 , -30 , 0) THEN DO
  13.     call notify(1,"!Can't find "MATHLIB)
  14.     exit
  15.     END
  16. sysnam = 'Compose Text Lines'
  17. filnam = 'ENV:Text.state'
  18. version = 'Text v1.0'
  19. lead=50
  20. typ=1
  21. just=1
  22. deep = 0.1
  23. wide = 0.02
  24. lines=4
  25. line.=""
  26. if (exists(filnam)) then do
  27.     if (~open(state, filnam, 'R')) then break
  28.     if (readln(state) ~= version) then break
  29.     parse value readln(state) with lead typ just .
  30.     do i=1 to lines
  31.       line.i = readln(state)
  32.     end
  33.     call close state
  34. end
  35.  
  36. call req_begin sysnam
  37. styles = 'Flat Block Chisel Round'
  38.  
  39. id_font = req_addcontrol("Font", 'F')
  40. id_typ = req_addcontrol("Text Type", "CH",Styles)
  41. id_just = req_addcontrol('Place','CH',"Center Left Right Justify Scale")
  42. id_deep = req_addcontrol("Depth", 'n', 1)
  43. id_wide = req_addcontrol("Edge Width", 'n', 1)
  44. do i=1 to lines
  45.   id_line.i = req_addcontrol("> ", 's', 35)
  46.   end
  47. id_lead = req_addcontrol("% Leading", 'n')
  48.  
  49. do i=1 to lines
  50.   call req_setval id_line.i, line.i
  51.   end
  52. line.i=""
  53.  
  54. call req_setval id_lead, lead,lead
  55. call req_setval id_just, just,1
  56. call req_setval id_typ, typ,1
  57. call req_setval id_deep, deep,0.1
  58. call req_setval id_wide, wide,0.02
  59.  
  60. if (~req_post()) then do
  61.     call req_end
  62.     exit
  63. end
  64. LineLen=0
  65. font = req_getval(id_font)
  66. do i=1 to lines
  67.   line.i = req_getval(id_line.i)
  68.   if length(line.i)>LineLen then do
  69.     LineLen=length(line.i)
  70.     longest=line.i
  71.     end
  72.   end
  73. lead = req_getval(id_lead)%1
  74. just = req_getval(id_just)-1
  75. typ = req_getval(id_typ)
  76. wide = req_getval(id_wide)
  77. deep = req_getval(id_deep)
  78. call req_end
  79.  
  80. if (open(state, filnam, 'W')) then do
  81.     call writeln state, version
  82.     call writeln state, lead typ just+1
  83.     do i=1 to lines
  84.       call writeln state, line.i
  85.     end
  86.     call close state
  87. end
  88.  
  89.  
  90. if LineLen=0 then exit
  91. call CUT()
  92. if font=0 then do
  93.   if(notify(2,"!Please Load A Font!","I can't continue without one")) then do
  94.     fname=GetFileName("Load Font","/ToasterFonts")
  95.     if fname~="(none)" then do
  96.       font=fontload(fname)
  97.       if font=0 then do
  98.         call notify(1,"!Can't load font "fname)
  99.         exit
  100.         end
  101.       end
  102.     end
  103.   end
  104.  
  105. LineWidth=MAKETEXT(longest,font,'B',wide*2)
  106. if LineWidth~=0 then call UNDO()
  107. call PASTE()
  108. /* call surface(surf) */
  109. /* call meter_begin lines+2, "Creating Formatted Text Object" */
  110. /* call meter_step() */
  111. say line.1
  112. h=CreateText(line.1, typ,just)
  113. stmarg=h + lead*h/100
  114. do i=2 to lines
  115. /*   call meter_step() */
  116.   if line.i~="" then do
  117.     say i h lead typ
  118.     marg=h + lead*h/100
  119.     if type=4 then call MOVE(0 marg 0)
  120.     else call MOVE(0 stmarg 0)
  121.     h=CreateText(line.i, typ)
  122.     say h
  123.     end
  124. end
  125. box=boundingbox()
  126. parse var box n x1 x2 y1 y2 z1 z2
  127. call MOVE(0 0-y1 0)
  128. /* call meter_end() */
  129. if (libadd) then call remlib("LWModelerARexx.port")
  130. exit
  131.  
  132. syntax:
  133. error:
  134.   call end_all
  135.     t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
  136.   if (libadd) then call remlib("LWModelerARexx.port")
  137.     exit
  138.  
  139. Center: Procedure
  140.   box=boundingbox()  /* Should check out empty list ...  */
  141.   parse var box n x1 x2 y1 y2 z1 z2
  142.   cx=-(x2-x1)/2
  143.   cy=-(y2-y1)/2
  144.   cz=-(z2-z1)/2
  145.   call MOVE(cx cy cz)
  146.   return box
  147.  
  148. CenterX: Procedure
  149.   box=boundingbox()  /* Should check out empty list ...  */
  150.   parse var box n x1 x2 y1 y2 z1 z2
  151.   cx=-(x2-x1)/2
  152.   call MOVE(cx 0 0)
  153.   return (y2-y1) /* Height */
  154.  
  155. CenterScaleX: Procedure
  156.   arg w
  157.   box=boundingbox()  /* Should check out empty list ...  */
  158.   parse var box n x1 x2 y1 y2 z1 z2
  159.   cx=-(x2-x1)/2
  160.   call MOVE(cx 0 0)
  161.   call SCALE(w/2*cx 1 1,0)
  162.   return (y2-y1) /* Height */
  163.  
  164. JustifyX: Procedure expose marg  /* 0=center, left=1, 2=right 3=justify 4=Aspect Justify*/
  165.   arg w, type
  166.   say w type
  167.   box=boundingbox()  /* Should check out empty list ...  */
  168.   parse var box n x1 x2 y1 y2 z1 z2
  169.   cx=-(x2-x1)/2
  170.   cy=(y2-y1)/2
  171.   select
  172.     when type=4 then do
  173.       call MOVE(cx 0 0)
  174.       call SCALE(w/(-2*cx) w/(-2*cx) 1,0 y2 0)
  175.       end
  176.     when type=3 then do
  177.       call MOVE(cx 0 0)
  178.       call SCALE(w/(-2*cx) 1 1,0)
  179.       end
  180.     when type=2 then call MOVE(2*cx 0 0)
  181.     when type=0 then call MOVE(cx 0 0)
  182.     otherwise nop
  183.     end
  184. if type=4 then return (y2-y1)*w/(-2*cx) /* Height */
  185. else return (y2-y1)
  186.  
  187. Bevel_Slab:
  188.   txlayer=curlayer()
  189.   empty=emptylayers()
  190.   if empty~="" then do
  191.     slablayer=word(empty,1)
  192.     end
  193.   else do    /* Need 1 layer to transform in */
  194.     call notify(1,'!'sysnam,'@Sorry, No Scratch Layer Available')
  195.     return
  196.     end
  197.   box=boundingbox()
  198.   parse var box n x1 x2 y1 y2 z1 z2
  199.   z2=z1+deep*2
  200.   call surface("Slab")
  201.   call MAKEBOX(x1 y1 z1, x2 y2 z2)
  202.   call smoothshift(wide)
  203.   call setblayer(txlayer)
  204.   call BOOLEAN(SUBTRACT)
  205.   call setlayer(txlayer)
  206.   call Cut()
  207.   call setlayer(slablayer)
  208.   call Cut()
  209.   call setlayer(txlayer)
  210.   call Paste()
  211.   return
  212.  
  213. Bevel_Flat:
  214.     call cut
  215.     return
  216.  
  217. Bevel_Block:
  218.     call bevel(0, deep / 2)
  219.     return
  220.  
  221. Bevel_Chisel:
  222.     call shapebevel(-wide wide (-wide) deep/2)
  223.     return
  224.  
  225. Bevel_Round:
  226.     n = 5
  227.     pat = ''
  228.     do i=1 to n
  229.         a = 3.14159/2 * i / n
  230.         pat = pat (-sin(a)*wide) (1-cos(a))*wide
  231.       end i
  232.     call shapebevel(pat (-wide) deep/2)
  233.     return
  234.  
  235. CreateText: PROCEDURE expose font wide styles deep just LineWidth
  236.   parse arg txt,typ
  237.   say txt typ
  238.   origl = curlayer()
  239.   empty = emptylayers()
  240.   if (words(empty) < 2) then do
  241.     call notify 1,syscode,"!Need at least two empty layers","!for this operation."
  242.     exit
  243.     end
  244.   sl1 = word(empty, 1)
  245.   sl2 = word(empty, 2)
  246.   sbase = ''
  247.   do i=1 to words(txt)
  248.     sbase = sbase || word(txt, i)
  249.     if length(sbase) >= 5 then leave
  250.     end
  251.   if length(sbase) > 15 then sbase = left(sbase, 15)
  252.   corners = 'B B S S S'
  253.   call setlayer sl1
  254.   w= maketext(txt, font, word(corners, typ), wide * 2)
  255.   call copy
  256.   call setlayer sl2
  257.   call paste
  258.   call sel_mode('user')
  259.   call sel_polygon('set')
  260.   interpret 'call Bevel_' || word(styles, typ)
  261.   call cut
  262.   call changesurface(sbase || "_Side")
  263.   call setlayer sl1 /* Get the correct faces from sl1. */
  264.   call changesurface(sbase || "_Face")
  265.   call flip
  266.   call cut
  267.   call setlayer sl2
  268.   call paste
  269.   call mirror(Z, -deep/2)
  270.   call mergepoints
  271.   x=JustifyX(LineWidth,just)
  272.   call cut
  273.   call setlayer origl
  274.   call paste
  275.   return x
  276.